;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
;;  distribution terms for this software are covered by the Eclipse Public
;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;;  be found in the file epl-v10.html at the root of this distribution.  By
;;  using this software in any fashion, you are agreeing to be bound by the
;;  terms of this license.  You must not remove this nogtice, or any other,
;;  from this software.
;;
;;  eval.clj
;;
;;  A Clojure implementation of Datalog -- Evaluator
;;
;;  straszheimjeffrey (gmail)
;;  Created 3 Feburary 2009


(ns clojure.datalog.eval
  (:use clojure.datalog.rules)
  (:use clojure.datalog.util)
  (:use [clojure.set :only (union difference)])
  (:use [clojure.contrib.seq-utils :only (separate)]))



;;; Work elements.  A work element can be a single rule, or a
;;; recursive set of rules.

(defstruct rule-work-element
  :rules                             ; The rule or rules
  :dependent-relations               ; What relations this depends on
  :provided-relations                ; What relations this provides
  :priority                          ; For ordering work
  :recursive)                        ; Determines if this is a set of recursive rules

;; Note: the rules field will contain a set of rules for a recursive
;; work element, but a single rule for non-recursive elements.

(defn- make-simple-work-element
  [rule]
  (struct-map rule-work-element
    :rules rule
    :dependent-relations (rule-dependent-relations rule)
    :provided-relations #{(rule-relation rule)}
    :priority 0
    :recursive false))

(defn- make-recursive-work-element
  [rules]
  (struct-map rule-work-element
    :rules rules
    :dependent-relations (reduce union #{} (map rule-dependent-relations rules))
    :provided-relations (set (map rule-relation rules))
    :priority 0
    :recursive true))

(defn print-work-element
  [element]
  (if (:recursive element)
    (doseq [rule (:rules element)]
      (println (display-logic-rule rule)))
    (println (display-logic-rule (:rules element))))
  (println (:provided-relations element))
  (println (:dependent-relations element)))

;;; Dependencies of Work Elements

(defn- work-elements-graph
  [elements]
  (struct-map directed-graph
    :nodes elements
    :get-keys :provided-relations
    :get-neighbors :dependent-relations))

(defn- new-element
  [element dependents]
  (let [adjusted (disj dependents element)]
    (assoc element :priority (inc (apply max -1 (map :priority adjusted))))))

(defn- compute-dependencies
  "Return a vec with the elements arrange by dependency groups.  Those
   at index 1 depend on those at index 0, those at 2 depend on those
   at 1, and so on."
  [elements]
  (let [level :priority
        with-levels (build-dependency-levels ; fixed point computation
                     (work-elements-graph elements)
                     level
                     new-element)]
    (build-dependency-array (:nodes with-levels) level)))


;;; Identify recursive rules

;; Rules can either be individual, or recursive (including mutually recursive).
;; This code identifies the groups of mutual recursion, and groups them into
;; single work elements.

(defn- rule-graph
  [rules]
  (struct-map directed-graph
      :nodes rules
      :get-keys (fn [x] #{(rule-relation x)})
      :get-neighbors rule-dependent-relations))

(defn- make-all-work-elements
  [rules]
  (let [all (set rules)
        recursive-sets (partition-into-recursive-sets (rule-graph all))
        recursives (reduce union #{} recursive-sets)
        non-recursives (difference all recursives)]
    (concat (map make-simple-work-element non-recursives)
            (map make-recursive-work-element recursive-sets))))

;;; Final construction of a negation-safe set of rules

(defn construct-prioritized-work-set
  [rules]
  (compute-dependencies (make-all-work-elements rules)))


;;; Run work elements

(defn- run-simple-work-element
  "Matches a simple work element against the database, and returns a new relation"
  [element database]
  (assert (not (:recursive element)))
  (match-rule (:rules element) database))

(defn- run-recursive-work-element
  "Using a parallel fixed-point computation, runs the recursive
   collection of rules against the database until done."
  [element database]
  (assert (:recursive element))
  (let [rules (:rules element)
        action (fn [data] (let [action (fn [rule] 
                                         (match-rule rule data))
                                results (pmap action rules)]
                            (preduce union (cons database results))))
        max -2 ; no limit
        transform (fn [database]
                    (map-values count database))]
    (fixed-point database action max transform)))
  
(defn- run-work-elements-in-parallel
  "Runs a group of work elements in parallel. Returns an extended database."
  [elements database]
  (let [[rec simp] (separate :recursive elements)
        results-simp (pmap #(run-simple-work-element % database) simp)
        results-rec (map #(run-recursive-work-element % database) rec)
        results (concat results-simp results-rec)]
    (preduce union (cons database results))))
 
(defn run-work-elements
  "Runs through a sequence of work element groups, passing the results
   of the early groups on to the later groups."
  [elements-seq database]
  (reduce (fn [database elements] (run-work-elements-in-parallel elements database))
          database
          elements-seq))


(comment

(def test-data
     {
      :employees
      #{
        { :id 1 :name "Sally" :position :boss              :supervisor nil }
        { :id 2 :name "Fred"  :position :accountant        :supervisor 1   }
        { :id 3 :name "Janet" :position :accountant        :supervisor 2   }
        { :id 4 :name "Mike"  :position :senior-programmer :supervisor 1   }
        { :id 5 :name "Sue"   :position :programmer        :supervisor 4   }
        { :id 6 :name "Jorge" :position :technition        :supervisor 4   }
        { :id 7 :name "Jack"  :position :sales             :supervisor 1   }
        { :id 8 :name "Jan"   :position :sales             :supervisor 7   }
        { :id 9 :name "Becky" :position :project-manager   :supervisor 1   }}
      :jobs
      #{
        { :id :payroll            :name "Payroll"              }
        { :id :accounting         :name "Accounting"           }
        { :id :software-dev       :name "Software Development" }
        { :id :computer-support   :name "Computer Support"     }
        { :id :server-support     :name "Server Support"       }
        { :id :sales              :name "Sales"                }
        { :id :project-management :name "Project Management"   }}
      :main-job
      #{
        { :empl-id 2 :job-id :accounting         }
        { :empl-id 3 :job-id :accounting         }
        { :empl-id 4 :job-id :software-dev       }
        { :empl-id 5 :job-id :software-dev       }
        { :empl-id 6 :job-id :server-support     }
        { :empl-id 7 :job-id :sales              }
        { :empl-id 8 :job-id :sales              }
        { :empl-id 9 :job-id :project-management }}})
        

(def test-rules
     [(logic-rule (:outranked-by :id ?x :super ?y) - (:employees :id ?x :supervisor ?y))

      (logic-rule (:outranked-by :id ?x :super ?y) -
                    (:outranked-by :id ?x :super ?z)
                    (:outranked-by :id ?z :super ?y))

      (logic-rule (:outranked-names :name ?x :super-name ?y) -
                    (:outranked-by :id ?u :super ?v)
                    (:employees :name ?x :id ?u)
                    (:employees :name ?y :id ?v))

      (logic-rule (:can-do-job :empl-id ?x :job-id ?y) - (:main-job :empl-id ?x :job-id ?y))

      (logic-rule (:can-do-job :empl-id ?x :job-id :computer-support) -
                     (:can-do-job :empl-id ?x :job-id :software-dev))

      (logic-rule (:can-do-job :empl-id ?x :job-id :computer-support) -
                     (:can-do-job :empl-id ?x :job-id :server-support))

      (logic-rule (:can-do-job :empl-id ?x :job-id :payroll) -
                     (:can-do-job :empl-id ?x :job-id :accounting))

      (logic-rule (:can-do-job :empl-id ?x :job-id ?y) -
                     (:employees :position :boss :id ?x)
                     (:jobs :id ?y))

      (logic-rule (:by-name :employee ?x :job ?y) -
                     (:employees :name ?x :id ?empl-id)
                     (:jobs      :name ?y :id ?job-id)
                     (:can-do-job :empl-id ?empl-id :job-id ?job-id))

      (logic-rule (:bosses-work :job-id ?x) - (:by-name :employee ?y :job ?x)
                                              (:employees :name ?y :position :boss))])
                
(def test-elements (construct-prioritized-work-set test-rules))
(def test-results (run-work-elements test-elements test-data))
(:by-name test-results)
(:bosses-work test-results)
(:outranked-names test-results)

)


;; End of file
